# Legacy Code
# x <- Sys.glob("../norm_dr_sd_min/data/coop_ratio/*.csv")
# 
# 
# for(i in x){
# 
#   tournament_type <- "hetero_dr_sd_min"
#   seed <- str_remove(i,".*data_") %>%
#     str_remove(".csv")
#   save_name <- paste0("../norm_dr_sd_min/data/coop_ratio/data_", seed, ".csv")
# 
#   df <- read_csv(i) %>%
#     mutate(tournament_type = "hetero_dr_sd_min")
#   
#   print(df)
#   write_csv(df, paste0(save_name))
# 
# }
# 
# for(i in x){
# 
#   tournament_type <- str_remove(i, "../") %>%
#     str_remove("/data/outliers/.*")
#   seed <- str_remove(i, ".*outliers/") %>%
#     str_remove("_outlier_counts.csv")
#   save_name <- paste0("../", tournament_type, "/data/outliers/", seed, "_harmonized.csv")
# 
#   df <- read_csv(i) %>%
#     select(S.D., Counts) %>%
#     mutate(seed = seed,
#            tournament_type = tournament_type)
#   write_csv(df, paste0(save_name))
# 
# }

# df_outliers_max <- do.call(rbind, lapply(Sys.glob("../*max/data/outliers/*harmonized.csv"), read_csv))
# df_outliers_min <- do.call(rbind, lapply(Sys.glob("../*min/data/outliers/*harmonized.csv"), read_csv))
# df_outliers_homo <- do.call(rbind, lapply(Sys.glob("../control_group/data/outliers/*_seed"), read_csv)) %>%
#   mutate(tournament_type = "control_group")
# df_outliers <- df_outliers_max %>%
#   rbind(df_outliers_homo) %>%
#   rbind(df_outliers_min) %>%
#   mutate(tournament_type = case_when(
#     tournament_type == "pareto_m_min" ~ "pareto_m_max",
#     tournament_type == "pareto_dr_min" ~ "pareto_dr_max",
#     tournament_type == "pareto_mdr_min" ~ "pareto_mdr_max",
#     tournament_type == "pareto_m_max" ~ "pareto_m_min",
#     tournament_type == "pareto_dr_max" ~ "pareto_dr_min",
#     tournament_type == "pareto_mdr_max" ~ "pareto_mdr_min",
#     TRUE ~ as.character(tournament_type))
#     )
# rm(df_outliers_max, df_outliers_homo, df_outliers_min)
# df_coop_homo <- do.call(rbind, lapply(Sys.glob("../control_group/data/coop_ratio/*.csv"), read_csv))
# df_coop_max <- do.call(rbind, lapply(Sys.glob("../*max/data/coop_ratio/*.csv"), read_csv))
# df_coop_min <- do.call(rbind, lapply(Sys.glob("../*min/data/coop_ratio/*.csv"), read_csv))
# df_coop <- df_coop_homo %>%
#   rbind(df_coop_max) %>%
#   rbind(df_coop_min) %>%
#   mutate(tournament_type = case_when(
#     tournament_type == "pareto_m_min" ~ "pareto_m_max",
#     tournament_type == "pareto_dr_min" ~ "pareto_dr_max",
#     tournament_type == "pareto_mdr_min" ~ "pareto_mdr_max",
#     tournament_type == "pareto_m_max" ~ "pareto_m_min",
#     tournament_type == "pareto_dr_max" ~ "pareto_dr_min",
#     tournament_type == "pareto_mdr_max" ~ "pareto_mdr_min",
#     TRUE ~ as.character(tournament_type))
#     )
# rm(df_coop_homo,df_coop_max,df_coop_min)

Import data

df_coop <- read_csv("results/cooperation_ratio.csv")
df_outliers <- read_csv("results/outliers.csv")

Cooperation Ratio

Analysis of cooperation ratio

df_coop %>%
  group_by(tournament_type) %>%
  summarise(mean_coop = round(mean(coop_ratio),3),
            sd_coop = round(sd(coop_ratio),3)) %>%
  ungroup() %>%
  arrange(desc(mean_coop)) %>%
  select(`Tournament` = tournament_type, `average cooperation ratio` = mean_coop, `standard deviation` = sd_coop) %>%
  kable(caption = "Tournament types arranged by mean of cooperation ratio") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
Tournament types arranged by mean of cooperation ratio
Tournament average cooperation ratio standard deviation
hetero_dr_sd_max 0.600 0.161
homogenous 0.589 0.154
pareto_m_min 0.589 0.157
hetero_m_sd_max 0.586 0.157
pareto_mdr_min 0.583 0.162
hetero_mdr_sd_max 0.582 0.166
hetero_m_sd_min 0.580 0.161
pareto_dr_min 0.580 0.154
hetero_dr_sd_min 0.579 0.161
hetero_mdr_sd_min 0.579 0.160
pareto_m_max 0.575 0.158
pareto_mdr_max 0.572 0.162
pareto_dr_max 0.571 0.164 
df_coop %>%
  group_by(tournament_type) %>%
  summarise(mean_coop = round(mean(coop_ratio),3),
            sd_coop = round(sd(coop_ratio),3)) %>%
  ungroup() %>%
  arrange(desc(sd_coop)) %>%
  select(`Tournament` = tournament_type, `average cooperation ratio` = mean_coop, `standard deviation` = sd_coop) %>%
  kable(caption = "Tournament types arranged by s.d. of cooperation ratio") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
Tournament types arranged by s.d. of cooperation ratio
Tournament average cooperation ratio standard deviation
hetero_mdr_sd_max 0.582 0.166
pareto_dr_max 0.571 0.164
pareto_mdr_max 0.572 0.162
pareto_mdr_min 0.583 0.162
hetero_dr_sd_max 0.600 0.161
hetero_dr_sd_min 0.579 0.161
hetero_m_sd_min 0.580 0.161
hetero_mdr_sd_min 0.579 0.160
pareto_m_max 0.575 0.158
hetero_m_sd_max 0.586 0.157
pareto_m_min 0.589 0.157
homogenous 0.589 0.154
pareto_dr_min 0.580 0.154 
df_coop %>%
  group_by(tournament_type, seed) %>%
  summarise(mean_coop = mean(coop_ratio),
            sd_coop = sd(coop_ratio)) %>%
  ggplot(aes(x = as.factor(seed), y = mean_coop)) +
    geom_bar(stat="identity") +
    geom_errorbar(aes(ymin = mean_coop-sd_coop, ymax = mean_coop + sd_coop), width = .7) +
    facet_wrap(~tournament_type) +
    coord_flip() +
    scale_fill_grey(guide = F) +
    labs(title = "Mean cooperation ratio and standard deviation per seed, facetted by tournament type",
         y = "cooperatio ratio",
         x = " ")

Comparing the control group with heterogenous groups__

df_coop %>%
  ggplot(aes(round, coop_ratio, color = tournament_type)) +
  geom_smooth(color = "black") +
  facet_wrap(~tournament_type) +
  scale_color_grey(guide = F)

Stability

Comparison of All Groups

my_formula <- y ~ x

df_outliers %>%
  ggplot() +
  geom_point(aes(S.D., Counts, color = as.factor(seed))) +
  geom_smooth(aes(S.D., Counts), color = "black") +
  facet_wrap(~tournament_type) +
      scale_color_grey(guide = F) +
  labs(title = "Smooth function applied to count of outliers on standard deviation",
       x = "standard deviation",
       y = "count of outliers")

df_outliers %>%
  select(x = S.D., y = Counts, tournament_type, seed) %>%
    ggplot(aes(x = x, y = y)) +
      geom_point(aes(x, y, color = as.factor(seed))) +
      geom_smooth(method = "lm", color = "black", se=FALSE, formula = my_formula) +
      stat_poly_eq(formula = my_formula, 
                   aes(label = paste(..eq.label.., sep = "~~~")), 
                   parse = TRUE,
                   label.x = 2) +         
      facet_wrap(~tournament_type) +
            scale_color_grey(guide = F) +
  labs(title = "Linear function applied to count of outliers on standard deviation",
       x = "standard deviation",
       y = "count of outliers")

df_outliers %>%
  filter(S.D. <= 2) %>%
  select(x = S.D., y = Counts, tournament_type, seed) %>%
    ggplot(aes(x = x, y = y)) +
      geom_point(aes(x, y, color = as.factor(seed))) +
      geom_smooth(method = "lm", color = "black", se=FALSE, formula = my_formula) +
      stat_poly_eq(formula = my_formula, 
                   aes(label = paste(..eq.label.., sep = "~~~")), 
                   parse = TRUE,
                   label.x = 2) +         
      facet_wrap(~tournament_type) +
            scale_color_grey(guide = F) +
  labs(title = "Linear function applied to count of outliers on standard deviation",
       subtitle = "Range of S.D. limited from 0 to 1.5",
       x = "standard deviation",
       y = "count of outliers")

df_outliers %>%
  filter(S.D. <= 2) %>%
  group_by(tournament_type) %>%
    do({
      mod = lm(Counts ~ S.D., data = .)
      data.frame(Intercept = coef(mod)[1],
                 Slope = coef(mod)[2],
                 R2 = summary(mod)$r.squared)
    }) %>%
  arrange(desc(Intercept)) %>%
  select(`tournament type` = tournament_type, intercept = Intercept, slope = Slope, `r2` = R2) %>%
  kable() %>%
  kable_styling()
tournament type intercept slope r2
pareto_dr_min 375.8412 -173.1779 0.9652927
control_group 366.5375 -166.9000 0.9490888
pareto_m_min 364.4471 -167.6676 0.9524959
norm_m_sd_max 363.3324 -169.1309 0.9643471
norm_mdr_sd_min 362.6412 -168.7279 0.9541591
pareto_m_max 354.8750 -164.2500 0.9712504
pareto_mdr_max 353.1904 -162.3074 0.9457772
pareto_dr_max 349.6566 -161.9103 0.9529084
pareto_mdr_min 345.8625 -158.9000 0.9481187
norm_dr_sd_max 343.8375 -157.2000 0.9508106
norm_dr_sd_min 342.9221 -155.1676 0.9504934
norm_m_sd_min 341.5154 -154.4324 0.9585277
norm_mdr_sd_max 336.2353 -152.0632 0.9655064 
df_outliers %>%
  filter(S.D. <= 2) %>%
  group_by(tournament_type) %>%
    do({
      mod = lm(Counts ~ S.D., data = .)
      data.frame(Intercept = coef(mod)[1],
                 Slope = coef(mod)[2],
                 R2 = summary(mod)$r.squared)
    }) %>%
  arrange(desc(Slope)) %>%
  select(`tournament type` = tournament_type, intercept = Intercept, slope = Slope, `r2` = R2) %>%
  kable() %>%
  kable_styling()
tournament type intercept slope r2
norm_mdr_sd_max 336.2353 -152.0632 0.9655064
norm_m_sd_min 341.5154 -154.4324 0.9585277
norm_dr_sd_min 342.9221 -155.1676 0.9504934
norm_dr_sd_max 343.8375 -157.2000 0.9508106
pareto_mdr_min 345.8625 -158.9000 0.9481187
pareto_dr_max 349.6566 -161.9103 0.9529084
pareto_mdr_max 353.1904 -162.3074 0.9457772
pareto_m_max 354.8750 -164.2500 0.9712504
control_group 366.5375 -166.9000 0.9490888
pareto_m_min 364.4471 -167.6676 0.9524959
norm_mdr_sd_min 362.6412 -168.7279 0.9541591
norm_m_sd_max 363.3324 -169.1309 0.9643471
pareto_dr_min 375.8412 -173.1779 0.9652927

Determining slope and start of instability

df_slope_intercept <- df_outliers %>%
  filter(S.D. <= 2) %>%
  group_by(as.factor(tournament_type)) %>%
    do({
      mod = lm(Counts ~ S.D., data = .)
      data.frame(Intercept = coef(mod)[1],
                 Slope = coef(mod)[2],
                 R2 = summary(mod)$r.squared)
    }) %>%
  mutate(Var = -Intercept/Slope) %>%
  select(tournament_type = `as.factor(tournament_type)`, everything()) %>%
  right_join(df_outliers)  

df_slope_intercept %>%
  mutate(Intercept = round(Intercept, 0),
         Slope = round(Slope, 0),
         Var = round(Var, 2)) %>%
  mutate(Formula = str_c("alpha:", Intercept, "m:", Slope, "v:", Var, sep = " ")) %>%
  ggplot() +
  geom_point(aes(S.D., Counts, color = as.factor(seed))) +
  geom_abline(aes(intercept = Intercept, slope = Slope)) +
  geom_hline(yintercept = 0) +
  geom_text(aes(2.2, 300, label = Formula), size = 2.5) +
  facet_wrap(~tournament_type) +
              scale_color_grey(guide = F) +
  labs(title = "Linear function applied to count of outliers on standard deviation",
       subtitle = "Slope calculated for S.D. < 2",
       x = "standard deviation",
       y = "count of outliers")